home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / DDPLUS71.ZIP / RIPLINK.ZIP / RIP2PAS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-03-19  |  38.5 KB  |  1,183 lines
  1. Program RIP2Pas;
  2.  
  3. Uses
  4.   Dos, CRT;{OpCrt, OpeningTitle;}
  5.  
  6. Const
  7.   MegaArray : array[0..35] of Char = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  8.  
  9. Type
  10.   ParseStatus   = (None,Got_Excl,Got_Pipe,Got_Level,Got_SubLevel,Got_Command);
  11.   CharStatus    = (cNone,Pending,ContLine,Escaped);
  12.  
  13.   Str2          = string[2];
  14.   Str4          = string[4];
  15.   Str5          = string[5];
  16.   Str12         = string[12];
  17.  
  18. Var
  19.   Level,SubLevel : byte;
  20.   command        : char;
  21.   firstcmd,nextcommand,commanddone : boolean;
  22.   pstat          : parsestatus;
  23.   cstat          : charstatus;
  24.   lastc          : char;
  25.   rBuffer        : Array[1..1024] of char;
  26.   bufcount       : word;
  27.   str1           : string;
  28.   outfile        : text;
  29.  
  30. Procedure ParseRip(c : char); forward;
  31. Function DoRipChar(c : char): boolean; forward;
  32.  
  33. Function I2S(I: longint) : string; {inttostr}
  34. var
  35.   s     : string[11];
  36. begin
  37.   str(I,S);
  38.   i2s := s;
  39. end;
  40.  
  41. Function StrToInt(S: string) : longint;
  42. var
  43.   I     : longint;
  44.   code  : integer;
  45. begin
  46.   I := 0;
  47.   val(S,I,code);
  48.   strtoint := I;
  49. end;
  50.  
  51. Function TorF(b:boolean) : str5;
  52. begin
  53.   if b then
  54.     torf := 'True'
  55.   else
  56.     torf := 'False';
  57. end;
  58.  
  59. Function WordToMega(Num : word) : Str2;
  60. var
  61.   Num2          : word;
  62.   work1         : Char;
  63.   work2         : Char;
  64. begin
  65.   num2 := 0;
  66.   work1 := #0;
  67.   work2 := #0;
  68.   if (Num < 0) or (Num > 1295) then
  69.   begin
  70.     WordToMega := '  ';
  71.     Exit;
  72.   end;
  73.   while Num >= 36 do
  74.   begin
  75.     inc(num2);
  76.     dec(num,36);
  77.   end;
  78.   work1 := MegaArray[num2];
  79.   Work2 := MegaArray[num];
  80.   WordToMega := work1+work2
  81. end;
  82.  
  83. Function WordToMega4(Num : word) : Str4;
  84. var
  85.   Num2          : word;
  86.   num3          : word;
  87.   num4          : word;
  88.   work1         : Char;
  89.   work2         : Char;
  90.   work3         : char;
  91.   work4         : char;
  92. begin
  93.   num2 := 0;
  94.   num3 := 0;
  95.   num4 := 0;
  96.   work1 := #0;
  97.   work2 := #0;
  98.   work3 := #0;
  99.   work4 := #0;
  100.   if Num < 0 then
  101.   begin
  102.     WordToMega4 := '    ';
  103.     Exit;
  104.   end;
  105.   while Num >= 36 do
  106.   begin
  107.     inc(num2);
  108.     dec(num,36);
  109.   end;
  110.   while Num2 >= 36 do
  111.   begin
  112.     inc(num3);
  113.     dec(num2,36);
  114.   end;
  115.   while Num3 >= 36 do
  116.   begin
  117.     inc(num4);
  118.     dec(num3,36);
  119.   end;
  120.   work1 := MegaArray[num4];
  121.   work2 := MegaArray[num3];
  122.   work3 := MegaArray[num2];
  123.   Work4 := MegaArray[num];
  124.   WordToMega4 := work1+work2+work3+work4;
  125. end;
  126.  
  127. Function MegaToWord(S2 : Str2) : Word;
  128. var
  129.   Num           : word;
  130.   Num2          : word;
  131.   work1         : Char;
  132.   work2         : Char;
  133. begin
  134.   num := 0;
  135.   num2 := 0;
  136.   work1 := #0;
  137.   work2 := #0;
  138.  
  139.   work1 := upcase(s2[1]);
  140.   work2 := upcase(s2[2]);
  141.  
  142.   if not ord(work1) in [48..57,65..90] then
  143.     Exit;
  144.   if not ord(work2) in [48..57,65..90] then
  145.     Exit;
  146.  
  147.   if ord(work1) in [48..57] then
  148.     num2 := ord(work1)-48;
  149.   if ord(work1) in [65..90] then
  150.     num2 := ord(work1)-55;
  151.  
  152.   if ord(work2) in [48..57] then
  153.     num := ord(work2)-48;
  154.   if ord(work2) in [65..90] then
  155.     num := ord(work2)-55;
  156.  
  157.   while Num2 > 0 do
  158.   begin
  159.     dec(num2);
  160.     inc(num,36);
  161.   end;
  162.   MegaToWord := num;
  163. end;
  164.  
  165. Function Mega4ToLong(S4 : Str4) : Longint;
  166. var
  167.   Num           : longint;
  168.   Num2          : longint;
  169.   Num3          : longint;
  170.   Num4          : longint;
  171.   work1         : Char;
  172.   work2         : Char;
  173.   work3         : Char;
  174.   work4         : Char;
  175. begin
  176.   num := 0;
  177.   num2 := 0;
  178.   num3 := 0;
  179.   num4 := 0;
  180.   work1 := #0;
  181.   work2 := #0;
  182.   work3 := #0;
  183.   work4 := #0;
  184.  
  185.   work1 := upcase(s4[1]);
  186.   work2 := upcase(s4[2]);
  187.   work3 := upcase(s4[3]);
  188.   work4 := upcase(s4[4]);
  189.  
  190.   if not ord(work1) in [48..57,65..90] then
  191.     Exit;
  192.   if not ord(work2) in [48..57,65..90] then
  193.     Exit;
  194.   if not ord(work3) in [48..57,65..90] then
  195.     Exit;
  196.   if not ord(work4) in [48..57,65..90] then
  197.     Exit;
  198.  
  199.   if ord(work1) in [48..57] then
  200.     num4 := ord(work1)-48;
  201.   if ord(work1) in [65..90] then
  202.     num4 := ord(work1)-55;
  203.  
  204.   if ord(work2) in [48..57] then
  205.     num3 := ord(work2)-48;
  206.   if ord(work2) in [65..90] then
  207.     num3 := ord(work2)-55;
  208.  
  209.   if ord(work3) in [48..57] then
  210.     num2 := ord(work3)-48;
  211.   if ord(work3) in [65..90] then
  212.     num2 := ord(work3)-55;
  213.  
  214.   if ord(work4) in [48..57] then
  215.     num := ord(work4)-48;
  216.   if ord(work4) in [65..90] then
  217.     num := ord(work4)-55;
  218.  
  219.   while Num2 > 0 do
  220.   begin
  221.     dec(num2);
  222.     inc(num,36);
  223.   end;
  224.   while Num3 > 0 do
  225.   begin
  226.     dec(num3);
  227.     inc(num,1296);
  228.   end;
  229.   while Num4 > 0 do
  230.   begin
  231.     dec(num4);
  232.     inc(num,46656);
  233.   end;
  234.   Mega4ToLong := num;
  235. end;
  236.  
  237.  
  238. Function DisplayRIPfile(Path : string): boolean;
  239. var
  240.   FName         : String;
  241.   F             : file;
  242.   FBuf          : Array [0..1023] of Char;
  243.   BufRead       : Word;
  244.   BufCnt        : Word;
  245. begin
  246.   displayripfile := false;
  247.   FName := Path;
  248.   filemode := $20;
  249.   Assign(F,FName);
  250.   {$I-}
  251.   Reset(F,1);
  252.   {$I+}
  253.   if ioresult <> 0 then
  254.   begin
  255.     exit;
  256.   end;
  257.   displayripfile := true;
  258.   While not EOF(F) do
  259.   begin
  260.     fillchar(FBuf,1024,#0);
  261.     BlockRead(F,FBuf,1024,BufRead);
  262.     For BufCnt := 0 to BufRead-1 do
  263.     begin
  264.       ParseRip(fbuf[bufcnt]);
  265.     end;
  266.   end;
  267.   Close(F);
  268. end;
  269.  
  270. Procedure ParseRip(c : char);
  271. var
  272.   ctr : word;
  273. begin
  274.   if not DoRipChar(c) then
  275.   begin
  276.     fillchar(rbuffer,1024,#0);
  277.     bufcount := 0;
  278.     level := 0;
  279.     sublevel := 0;
  280.     command := #0;
  281.     lastc := #0;
  282.     firstcmd := false;
  283.     if nextcommand then
  284.       pstat := got_pipe
  285.     else
  286.       pstat := none;
  287.     nextcommand := false;
  288.     commanddone := false;
  289.     cstat := cnone;
  290.   end;
  291. end;
  292.  
  293. Procedure WritePasNorm(s:string);
  294. begin
  295.   writeln(outfile,'  ',s);
  296. end;
  297.  
  298. Procedure WritePas(s:string);
  299. begin
  300.   WritePasNorm('RIP^.Rip'+s);
  301. end;
  302.  
  303. Function DoRipChar(c : char): boolean;
  304. type
  305.   PointRec = record
  306.     X : word;
  307.     Y : word;
  308.   end;
  309.  
  310.   TempType = Array[1..512] of PointRec;
  311. var
  312.   doexit : boolean;
  313.   st5    : string[5];
  314.   tPos   : byte;
  315.   st2    : string[2];
  316.   w1,w2,w3,w4,w5,w6,w7,w8,w9,w10,w11,w12,w13,w14,w15,w16         : word;
  317.   b1,b2,b3,b4,b5                                                 : byte;
  318.   o1,o2                                                          : boolean;
  319.   s1,s2,s3,s4                                                    : string;
  320.   sCtr                                                           : byte;
  321.   TempPoly : TempType;
  322.   TempFPT  : array[1..8] of byte;
  323.  
  324.   Function MegaB(ch:char) :Boolean;
  325.   begin
  326.     if ch = '1' then
  327.       megab := true
  328.     else
  329.       megab := false;
  330.   end;
  331.  
  332.   Procedure DoTheButton;
  333.   var
  334.     sctr        : byte;
  335.   begin
  336.     s1 := ''; s2 := ''; s3 := ''; s4 := '';
  337.     for sctr := tpos+13 to bufcount do
  338.       s1 := s1 + rbuffer[sctr];
  339.     case pos('<>',s1) of
  340.       0 : begin
  341.             if s1 <> '' then
  342.             begin
  343.               s2 := s1;
  344.               s1 := '';
  345.             end;
  346.           end;
  347.       1 : delete(s1,1{index},2{count});
  348.       else
  349.       begin
  350.         s2 := copy(s1,1,pos('<>',s1)-1);
  351.         delete(s1,1,pos('<>',s1)+1);
  352.       end;
  353.     end;
  354.     case pos('<>',s1) of
  355.       0 : begin
  356.             if s1 <> '' then
  357.             begin
  358.               s3 := s1;
  359.               s1 := '';
  360.             end;
  361.           end;
  362.       1 : delete(s1,1{index},2{count});
  363.       else
  364.       begin
  365.         s3 := copy(s1,1,pos('<>',s1)-1);
  366.         delete(s1,1,pos('<>',s1)+1);
  367.       end;
  368.     end;
  369.     case pos('<>',s1) of
  370.       0 : begin
  371.             if s1 <> '' then
  372.             begin
  373.               s4 := s1;
  374.               s1 := '';
  375.             end;
  376.           end;
  377.       1 : delete(s1,1{index},2{count});
  378.       else
  379.       begin
  380.         s4 := copy(s1,1,pos('<>',s1)-1);
  381.         delete(s1,1,pos('<>',s1)+1);
  382.       end;
  383.     end;
  384.  
  385.     w1 := megatoword(rbuffer[tpos+1]+rbuffer[tpos+2]);
  386.     w2 := megatoword(rbuffer[tpos+3]+rbuffer[tpos+4]);
  387.     w3 := megatoword(rbuffer[tpos+5]+rbuffer[tpos+6]);
  388.     w4 := megatoword(rbuffer[tpos+7]+rbuffer[tpos+8]);
  389.     w5 := megatoword(rbuffer[tpos+9]+rbuffer[tpos+10]);
  390.     b1 := megatoword('0'+rbuffer[tpos+11]);
  391.     str1 := 'Button('+i2s(w1)+','+i2s(w2)+','+i2s(w3)+','+i2s(w4)+','+i2s(w5)+','+i2s(b1);
  392.     writepas(str1+','''+s2+''','''+s3+''','''+s4+''');');
  393.   end;
  394.  
  395.   Procedure DoTheButtonStyle;
  396.   begin
  397.     w1 := megatoword(rbuffer[tpos+1]+rbuffer[tpos+2]);
  398.     w2 := megatoword(rbuffer[tpos+3]+rbuffer[tpos+4]);
  399.     w3 := megatoword(rbuffer[tpos+5]+rbuffer[tpos+6]);
  400.     w4 := word(mega4tolong(rbuffer[tpos+7]+rbuffer[tpos+8]+rbuffer[tpos+9]+rbuffer[tpos+10]));
  401.     w5 := megatoword(rbuffer[tpos+11]+rbuffer[tpos+12]);
  402.     w6 := megatoword(rbuffer[tpos+13]+rbuffer[tpos+14]);
  403.     w7 := megatoword(rbuffer[tpos+15]+rbuffer[tpos+16]);
  404.     w8 := megatoword(rbuffer[tpos+17]+rbuffer[tpos+18]);
  405.     w9 := megatoword(rbuffer[tpos+19]+rbuffer[tpos+20]);
  406.     w10 := megatoword(rbuffer[tpos+21]+rbuffer[tpos+22]);
  407.     w11 := megatoword(rbuffer[tpos+23]+rbuffer[tpos+24]);
  408.     w12 := megatoword(rbuffer[tpos+25]+rbuffer[tpos+26]);
  409.     w13 := megatoword(rbuffer[tpos+27]+rbuffer[tpos+28]);
  410.     w14 := megatoword(rbuffer[tpos+29]+rbuffer[tpos+30]);
  411.     str1 := 'ButtonStyle('+i2s(w1)+','+i2s(w2)+','+i2s(w3)+','+i2s(w4)+','+i2s(w5)+','+i2s(w6)+','+i2s(w7);
  412.     str1 := str1 + ','+i2s(w8)+','+i2s(w9)+','+i2s(w10)+','+i2s(w11)+','+i2s(w12)+','+i2s(w13)+','+i2s(w14)+');';
  413.     writepas(str1);
  414.   end;
  415.  
  416.   Procedure DoSetPalette;
  417.   begin
  418.     w1  := megatoword(rbuffer[tpos+1 ]+rbuffer[tpos+2 ]);
  419.     w2  := megatoword(rbuffer[tpos+3 ]+rbuffer[tpos+4 ]);
  420.     w3  := megatoword(rbuffer[tpos+5 ]+rbuffer[tpos+6 ]);
  421.     w4  := megatoword(rbuffer[tpos+7 ]+rbuffer[tpos+8 ]);
  422.     w5  := megatoword(rbuffer[tpos+9 ]+rbuffer[tpos+10]);
  423.     w6  := megatoword(rbuffer[tpos+11]+rbuffer[tpos+12]);
  424.     w7  := megatoword(rbuffer[tpos+13]+rbuffer[tpos+14]);
  425.     w8  := megatoword(rbuffer[tpos+15]+rbuffer[tpos+16]);
  426.     w9  := megatoword(rbuffer[tpos+17]+rbuffer[tpos+18]);
  427.     w10 := megatoword(rbuffer[tpos+19]+rbuffer[tpos+20]);
  428.     w11 := megatoword(rbuffer[tpos+21]+rbuffer[tpos+22]);
  429.     w12 := megatoword(rbuffer[tpos+23]+rbuffer[tpos+24]);
  430.     w13 := megatoword(rbuffer[tpos+25]+rbuffer[tpos+26]);
  431.     w14 := megatoword(rbuffer[tpos+27]+rbuffer[tpos+28]);
  432.     w15 := megatoword(rbuffer[tpos+29]+rbuffer[tpos+30]);
  433.     w16 := megatoword(rbuffer[tpos+31]+rbuffer[tpos+32]);
  434.     str1 := 'SetPalette('+i2s(w1)+','+i2s(w2)+','+i2s(w3)+','+i2s(w4)+','+i2s(w5)+','+i2s(w6)+','+i2s(w7)+','+i2s(w8);
  435.     str1 := str1+','+i2s(w9)+','+i2s(w10)+','+i2s(w11)+','+i2s(w12)+','+i2s(w13)+','+i2s(w14)+','+i2s(w15)+','+i2s(w16)+');';
  436.     writepas(str1);
  437.   end;
  438.  
  439.   Procedure DoFillPattern;
  440.   begin
  441.     tempfpt[1] := megatoword(rbuffer[tpos+1]+rbuffer[tpos+2]);
  442.     tempfpt[2] := megatoword(rbuffer[tpos+3]+rbuffer[tpos+4]);
  443.     tempfpt[3] := megatoword(rbuffer[tpos+5]+rbuffer[tpos+6]);
  444.     tempfpt[4] := megatoword(rbuffer[tpos+7]+rbuffer[tpos+8]);
  445.     tempfpt[5] := megatoword(rbuffer[tpos+9]+rbuffer[tpos+10]);
  446.     tempfpt[6] := megatoword(rbuffer[tpos+11]+rbuffer[tpos+12]);
  447.     tempfpt[7] := megatoword(rbuffer[tpos+13]+rbuffer[tpos+14]);
  448.     tempfpt[8] := megatoword(rbuffer[tpos+15]+rbuffer[tpos+16]);
  449.     w1 := megatoword(rbuffer[tpos+17]+rbuffer[tpos+18]);
  450.     writepasnorm('tFPT[1] := '+i2s(tempfpt[1])+';');
  451.     writepasnorm('tFPT[2] := '+i2s(tempfpt[2])+';');
  452.     writepasnorm('tFPT[3] := '+i2s(tempfpt[3])+';');
  453.     writepasnorm('tFPT[4] := '+i2s(tempfpt[4])+';');
  454.     writepasnorm('tFPT[5] := '+i2s(tempfpt[5])+';');
  455.     writepasnorm('tFPT[6] := '+i2s(tempfpt[6])+';');
  456.     writepasnorm('tFPT[7] := '+i2s(tempfpt[7])+';');
  457.     writepasnorm('tFPT[8] := '+i2s(tempfpt[8])+';');
  458.     writepas('FillPattern(tFPT,'+i2s(w1)+');');
  459.   end;
  460.  
  461. begin
  462.   doripchar := false;
  463.   doexit := false;
  464.   {if (c = '|') then
  465.     readkey;}
  466.   if (c = #13) then
  467.     firstcmd := true;
  468.   if firstcmd then
  469.     if not (c in [#13,#10,'!']) then
  470.       firstcmd := false;
  471.   if (not (c in [#13,#10])) and ((not (c in ['\','|','!']))) then
  472.   begin
  473.     inc(bufcount);
  474.     rbuffer[bufcount] := c;
  475.   end;
  476.  
  477.   case pstat of
  478.     None          : begin
  479.       if firstcmd then
  480.       begin
  481.         if c = '!' then
  482.           pstat := got_excl
  483.         else
  484.           exit;
  485.       end
  486.       else
  487.         if c in [#1,#2] then
  488.           pstat := got_excl
  489.         else
  490.           if c = '|' then
  491.             pstat := got_pipe
  492.           else
  493.             exit;
  494.     end;
  495.     Got_Excl      : begin
  496.       if c = '|' then
  497.         pstat := got_pipe
  498.       else
  499.         exit;
  500.     end;
  501.     Got_Pipe      : begin
  502.       case c of
  503.         '1'..'9' : begin
  504.                      level := strtoint(c);
  505.                      pstat := got_level;
  506.                    end;
  507.         #27,'#','*','=','>','@','A'..'Z','a'..'z' :
  508.                    begin
  509.                      level := 0;
  510.                      command := c;
  511.                      pstat := got_command;
  512.                    end;
  513.         else
  514.           exit;
  515.       end;
  516.     end;
  517.     Got_Level     : begin
  518.       case c of
  519.         '0'      : begin
  520.                      sublevel := 10;
  521.                      pstat := got_sublevel;
  522.                    end;
  523.         '1'..'9' : begin
  524.                      sublevel := strtoint(c);
  525.                      pstat := got_sublevel;
  526.                    end;
  527.         #27,'#','*','=','>','@','A'..'Z','a'..'z' :
  528.                    begin
  529.                      command := c;
  530.                      pstat := got_command;
  531.                    end;
  532.         else
  533.           exit;
  534.       end;
  535.     end;
  536.     Got_SubLevel  : begin
  537.       if c in [#27,'#','*','=','>','@','A'..'Z','a'..'z'] then
  538.       begin
  539.         command := c;
  540.         pstat := got_command;
  541.       end
  542.       else
  543.         exit;
  544.     end;
  545.     Got_Command   : begin
  546.       if firstcmd and (cstat <> contline) and (cstat <> pending) then
  547.         doexit := true;
  548.       case cstat of
  549.         pending  : begin
  550.                      if c = #13 then
  551.                        cstat := contline
  552.                      else
  553.                        cstat := escaped;
  554.                    end;
  555.         contline : cstat := cnone;
  556.       end;
  557.       if (c = '\') and (cstat <> escaped) then
  558.         cstat := pending;
  559.       if (c = '|') and (cstat <> escaped) then
  560.         nextcommand := true;
  561.       if (cstat = escaped) and (c in ['\','!','|']) then
  562.       begin
  563.         inc(bufcount);
  564.         rbuffer[bufcount] := c;
  565.         cstat := cnone;
  566.       end;
  567.       st5 := rbuffer[1]+rbuffer[2]+rbuffer[3]+rbuffer[4]+rbuffer[5];
  568.       tpos := pos(command,st5);
  569.       case level of
  570.         0 : begin
  571.           case command of
  572.             'w' : begin {text window}
  573.               if bufcount = (pos('w',st5)+ 10) then
  574.               begin
  575.                 b1 := megatoword(rbuffer[tpos+1]+rbuffer[tpos+2]);
  576.                 b2 := megatoword(rbuffer[tpos+3]+rbuffer[tpos+4]);
  577.                 b3 := megatoword(rbuffer[tpos+5]+rbuffer[tpos+6]);
  578.                 b4 := megatoword(rbuffer[tpos+7]+rbuffer[tpos+8]);
  579.                 b5 := megatoword('0'            +rbuffer[tpos+10]);
  580.                 o1 := megab(rbuffer[tpos+9]);
  581.                 writepas('TextWindow('+i2s(b1)+','+i2s(b2)+','+i2s(b3)+','+i2s(b4)+','+torf(o1)+','+i2s(b5)+');');
  582.                 exit;
  583.               end;
  584.             end;
  585.             'v' : begin {view port}
  586.               if bufcount = (pos('v',st5)+ 8) then
  587.               begin
  588.                 w1 := megatoword(rbuffer[tpos+1]+rbuffer[tpos+2]);
  589.                 w2 := megatoword(rbuffer[tpos+3]+rbuffer[tpos+4]);
  590.                 w3 := megatoword(rbuffer[tpos+5]+rbuffer[tpos+6]);
  591.                 w4 := megatoword(rbuffer[tpos+7]+rbuffer[tpos+8]);
  592.                 writepas('ViewPort('+i2s(w1)+','+i2s(w2)+','+i2s(w3)+','+i2s(w4)+');');
  593.                 exit;
  594.               end;
  595.             end;
  596.             '*' : begin {reset windows}
  597.               writepas('ResetWindows;');
  598.               exit;
  599.             end;
  600.             'e' : begin {erase window}
  601.               writepas('EraseWindow;');
  602.               exit;
  603.             end;
  604.             'E' : begin {erase view}
  605.               writepas('EraseView;');
  606.               exit;
  607.             end;
  608.             'g' : begin {gotoxy}
  609.               if bufcount = (pos('g',st5)+ 4) then
  610.               begin
  611.                 b1 := megatoword(rbuffer[tpos+1]+rbuffer[tpos+2]);
  612.                 b2 := megatoword(rbuffer[tpos+3]+rbuffer[tpos+4]);
  613.                 writepas('GotoXY('+i2s(b1)+','+i2s(b2)+');');
  614.                 exit;
  615.               end;
  616.             end;
  617.             'H' : begin {home}
  618.               writepas('Home;');
  619.               exit;
  620.             end;
  621.             '>' : begin {erase eol}
  622.               writepas('EraseEOL;');
  623.               exit;
  624.             end;
  625.             'c' : begin {color}
  626.               if bufcount = (pos('c',st5)+ 2) then
  627.               begin
  628.                 b1 := megatoword(rbuffer[tpos+1]+rbuffer[tpos+2]);
  629.                 writepas('Color('+i2s(b1)+');');
  630.                 exit;
  631.               end;
  632.             end;
  633.             'Q' : begin {set palette}
  634.               if bufcount = (pos('Q',st5)+ 32) then
  635.               begin
  636.                 DoSetPalette;
  637.                 exit;
  638.               end;
  639.             end;
  640.             'a' : begin {one palette}
  641.               if bufcount = (pos('a',st5)+ 4) then
  642.               begin
  643.                 w1 := megatoword(rbuffer[tpos+1]+rbuffer[tpos+2]);
  644.                 w2 := megatoword(rbuffer[tpos+3]+rbuffer[tpos+4]);
  645.                 writepas('OnePalette('+i2s(w1)+','+i2s(w2)+');');
  646.                 exit;
  647.               end;
  648.             end;
  649.             'W' : begin {write mode}
  650.               if bufcount = (pos('W',st5)+ 2) then
  651.               begin
  652.                 b1  := megatoword(rbuffer[tpos+1 ]+rbuffer[tpos+2 ]);
  653.                 writepas('WriteMode('+i2s(b1)+');');
  654.                 exit;
  655.               end;
  656.             end;
  657.             'm' : begin {move}
  658.               if bufcount = (pos('m',st5)+ 4) then
  659.               begin
  660.                 w1 := megatoword(rbuffer[tpos+1]+rbuffer[tpos+2]);
  661.                 w2 := megatoword(rbuffer[tpos+3]+rbuffer[tpos+4]);
  662.                 writepas('Move('+i2s(w1)+','+i2s(w2)+');');
  663.                 exit;
  664.               end;
  665.             end;
  666.             'T' : begin {text}
  667.               if doexit or nextcommand then
  668.               begin
  669.                 s1 := '';
  670.                 for sctr := tpos+1 to bufcount do
  671.                   s1 := s1 + rbuffer[sctr];
  672.                 writepas('Text('''+s1+''');');
  673.                 exit;
  674.               end;
  675.             end;
  676.             '@' : begin {textxy}
  677.               if doexit or nextcommand then
  678.               begin
  679.                 s1 := '';
  680.                 for sctr := tpos+1+4 to bufcount do
  681.                   s1 := s1 +rbuffer[sctr];
  682.                 w1 := megatoword(rbuffer[tpos+1]+rbuffer[tpos+2]);
  683.                 w2 := megatoword(rbuffer[tpos+3]+rbuffer[tpos+4]);
  684.                 writepas('TextXY('+i2s(w1)+','+i2s(w2)+','''+s1+''');');
  685.                 exit;
  686.               end;
  687.             end;
  688.             'Y' : begin {font style}
  689.               if bufcount = (pos('Y',st5)+ 8) then
  690.               begin
  691.                 b1 := megatoword(rbuffer[tpos+1]+rbuffer[tpos+2]);
  692.                 b2 := megatoword(rbuffer[tpos+3]+rbuffer[tpos+4]);
  693.                 b3 := megatoword(rbuffer[tpos+5]+rbuffer[tpos+6]);
  694.                 writepas('FontStyle('+i2s(b1)+','+i2s(b2)+','+i2s(b3)+');');
  695.                 exit;
  696.               end;
  697.             end;
  698.             'X' : begin {pixel}
  699.               if bufcount = (pos('X',st5)+ 4) then
  700.               begin
  701.                 w1 := megatoword(rbuffer[tpos+1]+rbuffer[tpos+2]);
  702.                 w2 := megatoword(rbuffer[tpos+3]+rbuffer[tpos+4]);
  703.                 writepas('Pixel('+i2s(w1)+','+i2s(w2)+');');
  704.                 exit;
  705.               end;
  706.             end;
  707.             'L' : begin {line}
  708.               if bufcount = (pos('L',st5)+ 8) then
  709.               begin
  710.                 w1 := megatoword(rbuffer[tpos+1]+rbuffer[tpos+2]);
  711.                 w2 := megatoword(rbuffer[tpos+3]+rbuffer[tpos+4]);
  712.                 w3 := megatoword(rbuffer[tpos+5]+rbuffer[tpos+6]);
  713.                 w4 := megatoword(rbuffer[tpos+7]+rbuffer[tpos+8]);
  714.                 writepas('Line('+i2s(w1)+','+i2s(w2)+','+i2s(w3)+','+i2s(w4)+');');
  715.                 exit;
  716.               end;
  717.             end;
  718.             'R' : begin {rectangle}
  719.               if bufcount = (pos('R',st5)+ 8) then
  720.               begin
  721.                 w1 := megatoword(rbuffer[tpos+1]+rbuffer[tpos+2]);
  722.                 w2 := megatoword(rbuffer[tpos+3]+rbuffer[tpos+4]);
  723.                 w3 := megatoword(rbuffer[tpos+5]+rbuffer[tpos+6]);
  724.                 w4 := megatoword(rbuffer[tpos+7]+rbuffer[tpos+8]);
  725.                 writepas('Rectangle('+i2s(w1)+','+i2s(w2)+','+i2s(w3)+','+i2s(w4)+');');
  726.                 exit;
  727.               end;
  728.             end;
  729.             'B' : begin {bar}
  730.               if bufcount = (pos('B',st5)+ 8) then
  731.               begin
  732.                 w1 := megatoword(rbuffer[tpos+1]+rbuffer[tpos+2]);
  733.                 w2 := megatoword(rbuffer[tpos+3]+rbuffer[tpos+4]);
  734.                 w3 := megatoword(rbuffer[tpos+5]+rbuffer[tpos+6]);
  735.                 w4 := megatoword(rbuffer[tpos+7]+rbuffer[tpos+8]);
  736.                 writepas('Bar('+i2s(w1)+','+i2s(w2)+','+i2s(w3)+','+i2s(w4)+');');
  737.                 exit;
  738.               end;
  739.             end;
  740.             'C' : begin {circle}
  741.               if bufcount = (pos('C',st5)+ 6) then
  742.               begin
  743.                 w1 := megatoword(rbuffer[tpos+1]+rbuffer[tpos+2]);
  744.                 w2 := megatoword(rbuffer[tpos+3]+rbuffer[tpos+4]);
  745.                 w3 := megatoword(rbuffer[tpos+5]+rbuffer[tpos+6]);
  746.                 writepas('Circle('+i2s(w1)+','+i2s(w2)+','+i2s(w3)+');');
  747.                 exit;
  748.               end;
  749.             end;
  750.             'O' : begin {oval}
  751.               if bufcount = (pos('O',st5)+ 12) then
  752.               begin
  753.                 w1 := megatoword(rbuffer[tpos+1]+rbuffer[tpos+2]);
  754.                 w2 := megatoword(rbuffer[tpos+3]+rbuffer[tpos+4]);
  755.                 w3 := megatoword(rbuffer[tpos+5]+rbuffer[tpos+6]);
  756.                 w4 := megatoword(rbuffer[tpos+7]+rbuffer[tpos+8]);
  757.                 w5 := megatoword(rbuffer[tpos+9]+rbuffer[tpos+10]);
  758.                 w6 := megatoword(rbuffer[tpos+11]+rbuffer[tpos+12]);
  759.                 writepas('Oval('+i2s(w1)+','+i2s(w2)+','+i2s(w3)+','+i2s(w4)+','+i2s(w5)+','+i2s(w6)+');');
  760.                 exit;
  761.               end;
  762.             end;
  763.             'o' : begin {filled oval}
  764.               if bufcount = (pos('o',st5)+ 8) then
  765.               begin
  766.                 w1 := megatoword(rbuffer[tpos+1]+rbuffer[tpos+2]);
  767.                 w2 := megatoword(rbuffer[tpos+3]+rbuffer[tpos+4]);
  768.                 w3 := megatoword(rbuffer[tpos+5]+rbuffer[tpos+6]);
  769.                 w4 := megatoword(rbuffer[tpos+7]+rbuffer[tpos+8]);
  770.                 writepas('FilledOval('+i2s(w1)+','+i2s(w2)+','+i2s(w3)+','+i2s(w4)+');');
  771.                 exit;
  772.               end;
  773.             end;
  774.             'A' : begin {arc}
  775.               if bufcount = (pos('A',st5)+ 10) then
  776.               begin
  777.                 w1 := megatoword(rbuffer[tpos+1]+rbuffer[tpos+2]);
  778.                 w2 := megatoword(rbuffer[tpos+3]+rbuffer[tpos+4]);
  779.                 w3 := megatoword(rbuffer[tpos+5]+rbuffer[tpos+6]);
  780.                 w4 := megatoword(rbuffer[tpos+7]+rbuffer[tpos+8]);
  781.                 w5 := megatoword(rbuffer[tpos+9]+rbuffer[tpos+10]);
  782.                 writepas('Arc('+i2s(w1)+','+i2s(w2)+','+i2s(w3)+','+i2s(w4)+','+i2s(w5)+');');
  783.                 exit;
  784.               end;
  785.             end;
  786.             'V' : begin {oval arc}
  787.               if bufcount = (pos('V',st5)+ 12) then
  788.               begin
  789.                 w1 := megatoword(rbuffer[tpos+1]+rbuffer[tpos+2]);
  790.                 w2 := megatoword(rbuffer[tpos+3]+rbuffer[tpos+4]);
  791.                 w3 := megatoword(rbuffer[tpos+5]+rbuffer[tpos+6]);
  792.                 w4 := megatoword(rbuffer[tpos+7]+rbuffer[tpos+8]);
  793.                 w5 := megatoword(rbuffer[tpos+9]+rbuffer[tpos+10]);
  794.                 w6 := megatoword(rbuffer[tpos+11]+rbuffer[tpos+12]);
  795.                 writepas('OvalArc('+i2s(w1)+','+i2s(w2)+','+i2s(w3)+','+i2s(w4)+','+i2s(w5)+','+i2s(w6)+');');
  796.                 exit;
  797.               end;
  798.             end;
  799.             'I' : begin {pie slice}
  800.               if bufcount = (pos('I',st5)+ 10) then
  801.               begin
  802.                 w1 := megatoword(rbuffer[tpos+1]+rbuffer[tpos+2]);
  803.                 w2 := megatoword(rbuffer[tpos+3]+rbuffer[tpos+4]);
  804.                 w3 := megatoword(rbuffer[tpos+5]+rbuffer[tpos+6]);
  805.                 w4 := megatoword(rbuffer[tpos+7]+rbuffer[tpos+8]);
  806.                 w5 := megatoword(rbuffer[tpos+9]+rbuffer[tpos+10]);
  807.                 writepas('PieSlice('+i2s(w1)+','+i2s(w2)+','+i2s(w3)+','+i2s(w4)+','+i2s(w5)+');');
  808.                 exit;
  809.               end;
  810.             end;
  811.             'i' : begin {oval pie slice}
  812.               if bufcount = (pos('i',st5)+ 12) then
  813.               begin
  814.                 w1 := megatoword(rbuffer[tpos+1]+rbuffer[tpos+2]);
  815.                 w2 := megatoword(rbuffer[tpos+3]+rbuffer[tpos+4]);
  816.                 w3 := megatoword(rbuffer[tpos+5]+rbuffer[tpos+6]);
  817.                 w4 := megatoword(rbuffer[tpos+7]+rbuffer[tpos+8]);
  818.                 w5 := megatoword(rbuffer[tpos+9]+rbuffer[tpos+10]);
  819.                 w6 := megatoword(rbuffer[tpos+11]+rbuffer[tpos+12]);
  820.                 writepas('OvalPieSlice('+i2s(w1)+','+i2s(w2)+','+i2s(w3)+','+i2s(w4)+','+i2s(w5)+','+i2s(w6)+');');
  821.                 exit;
  822.               end;
  823.             end;
  824.             'Z' : begin {bezier}
  825.               if bufcount = (pos('Z',st5)+ 18) then
  826.               begin
  827.                 w1 := megatoword(rbuffer[tpos+1]+rbuffer[tpos+2]);
  828.                 w2 := megatoword(rbuffer[tpos+3]+rbuffer[tpos+4]);
  829.                 w3 := megatoword(rbuffer[tpos+5]+rbuffer[tpos+6]);
  830.                 w4 := megatoword(rbuffer[tpos+7]+rbuffer[tpos+8]);
  831.                 w5 := megatoword(rbuffer[tpos+9]+rbuffer[tpos+10]);
  832.                 w6 := megatoword(rbuffer[tpos+11]+rbuffer[tpos+12]);
  833.                 w7 := megatoword(rbuffer[tpos+13]+rbuffer[tpos+14]);
  834.                 w8 := megatoword(rbuffer[tpos+15]+rbuffer[tpos+16]);
  835.                 w9 := megatoword(rbuffer[tpos+17]+rbuffer[tpos+18]);
  836.                 str1 := 'Bezier('+i2s(w1)+','+i2s(w2)+','+i2s(w3)+','+i2s(w4)+',';
  837.                 writepas(str1+i2s(w5)+','+i2s(w6)+','+i2s(w7)+','+i2s(w8)+','+i2s(w9)+');');
  838.                 exit;
  839.               end;
  840.             end;
  841.             'P' : begin {polygon}
  842.               tpos := pos('P',st5);
  843.               if bufcount >= (tpos+ 2) then
  844.               begin
  845.                 st2 := rbuffer[tpos+1]+rbuffer[tpos+2];
  846.                 if bufcount = (tpos+2+ (4* megatoword(st2))) then
  847.                 begin
  848.                   fillchar(temppoly,2048,#0);
  849.                   for sctr := 1 to megatoword(st2) do
  850.                   begin
  851.                     temppoly[sctr].X := megatoword(rbuffer[tpos+3+((sctr-1)*4)]+
  852.                                                    rbuffer[tpos+4+((sctr-1)*4)]);
  853.                     temppoly[sctr].Y := megatoword(rbuffer[tpos+5+((sctr-1)*4)]+
  854.                                                    rbuffer[tpos+6+((sctr-1)*4)]);
  855.                   end;
  856.                   w1 := megatoword(rbuffer[tpos+1]+rbuffer[tpos+2]);
  857.                   for sctr := 1 to megatoword(st2) do
  858.                   begin
  859.                     writepasnorm('PPoints['+i2s(sctr)+'].X := '+i2s(temppoly[sctr].X)+';');
  860.                     writepasnorm('PPoints['+i2s(sctr)+'].Y := '+i2s(temppoly[sctr].Y)+';');
  861.                   end;
  862.                   writepas('Polygon('+i2s(w1)+',PPoints);');
  863.                   exit;
  864.                 end;
  865.               end;
  866.             end;
  867.             'p' : begin {fill polygon}
  868.               tpos := pos('p',st5);
  869.               if bufcount >= (tpos+ 2) then
  870.               begin
  871.                 st2 := rbuffer[tpos+1]+rbuffer[tpos+2];
  872.                 if bufcount = (tpos+2+ (4* megatoword(st2))) then
  873.                 begin
  874.                   fillchar(temppoly,2048,#0);
  875.                   for sctr := 1 to megatoword(st2) do
  876.                   begin
  877.                     temppoly[sctr].X := megatoword(rbuffer[tpos+3+((sctr-1)*4)]+
  878.                                                    rbuffer[tpos+4+((sctr-1)*4)]);
  879.                     temppoly[sctr].Y := megatoword(rbuffer[tpos+5+((sctr-1)*4)]+
  880.                                                    rbuffer[tpos+6+((sctr-1)*4)]);
  881.                   end;
  882.                   w1 := megatoword(rbuffer[tpos+1]+rbuffer[tpos+2]);
  883.                   for sctr := 1 to megatoword(st2) do
  884.                   begin
  885.                     writepasnorm('PPoints['+i2s(sctr)+'].X := '+i2s(temppoly[sctr].X)+';');
  886.                     writepasnorm('PPoints['+i2s(sctr)+'].Y := '+i2s(temppoly[sctr].Y)+';');
  887.                   end;
  888.                   writepas('FillPoly('+i2s(w1)+',PPoints);');
  889.                   exit;
  890.                 end;
  891.               end;
  892.             end;
  893.             'l' : begin {polyline}
  894.               tpos := pos('l',st5);
  895.               if bufcount >= (tpos+ 2) then
  896.               begin
  897.                 st2 := rbuffer[tpos+1]+rbuffer[tpos+2];
  898.                 if bufcount = (tpos+2+ (4* megatoword(st2))) then
  899.                 begin
  900.                   fillchar(temppoly,2048,#0);
  901.                   for sctr := 1 to megatoword(st2) do
  902.                   begin
  903.                     temppoly[sctr].X := megatoword(rbuffer[tpos+3+((sctr-1)*4)]+
  904.                                                    rbuffer[tpos+4+((sctr-1)*4)]);
  905.                     temppoly[sctr].Y := megatoword(rbuffer[tpos+5+((sctr-1)*4)]+
  906.                                                    rbuffer[tpos+6+((sctr-1)*4)]);
  907.                   end;
  908.                   w1 := megatoword(rbuffer[tpos+1]+rbuffer[tpos+2]);
  909.                   for sctr := 1 to megatoword(st2) do
  910.                   begin
  911.                     writepasnorm('PPoints['+i2s(sctr)+'].X := '+i2s(temppoly[sctr].X)+';');
  912.                     writepasnorm('PPoints['+i2s(sctr)+'].Y := '+i2s(temppoly[sctr].Y)+';');
  913.                   end;
  914.                   writepas('PolyLine('+i2s(w1)+',PPoints);');
  915.                   exit;
  916.                 end;
  917.               end;
  918.             end;
  919.             'F' : begin {fill}
  920.               if bufcount = (pos('F',st5)+ 6) then
  921.               begin
  922.                 w1 := megatoword(rbuffer[tpos+1]+rbuffer[tpos+2]);
  923.                 w2 := megatoword(rbuffer[tpos+3]+rbuffer[tpos+4]);
  924.                 w3 := megatoword(rbuffer[tpos+5]+rbuffer[tpos+6]);
  925.                 writepas('Fill('+i2s(w1)+','+i2s(w2)+','+i2s(w3)+');');
  926.                 exit;
  927.               end;
  928.             end;
  929.             '=' : begin {line style}
  930.               if bufcount = (pos('=',st5)+ 8) then
  931.               begin
  932.                 w1 := megatoword(rbuffer[tpos+1]+rbuffer[tpos+2]);
  933.                 w2 := word(mega4tolong(rbuffer[tpos+3]+rbuffer[tpos+4]
  934.                                       +rbuffer[tpos+5]+rbuffer[tpos+6]));
  935.                 w3 := megatoword(rbuffer[tpos+7]+rbuffer[tpos+8]);
  936.                 writepas('LineStyle('+i2s(w1)+','+i2s(w2)+','+i2s(w3)+');');
  937.                 exit;
  938.               end;
  939.             end;
  940.             'S' : begin {fill style}
  941.               if bufcount = (pos('S',st5)+ 4) then
  942.               begin
  943.                 w1 := megatoword(rbuffer[tpos+1]+rbuffer[tpos+2]);
  944.                 w2 := megatoword(rbuffer[tpos+3]+rbuffer[tpos+4]);
  945.                 writepas('FillStyle('+i2s(w1)+','+i2s(w2)+');');
  946.                 exit;
  947.               end;
  948.             end;
  949.             's' : begin {fill pattern}
  950.               if bufcount = (pos('s',st5)+ 18) then
  951.               begin
  952.                 DoFillPattern;
  953.                 exit;
  954.               end;
  955.             end;
  956.             '#' : begin {no more}
  957.               writepas('NoMore;');
  958.             end;
  959.             else {case command of}
  960.               exit;
  961.           end; {case}
  962.         end;
  963.         1 : begin
  964.           case command of
  965.             'M' : begin {mouse}
  966.               if doexit or nextcommand then
  967.               begin
  968.                 s1 := '';
  969.                 for sctr := tpos+18 to bufcount do
  970.                   s1 := s1 + rbuffer[sctr];
  971.                 w1 := megatoword(rbuffer[tpos+3]+rbuffer[tpos+4]);
  972.                 w2 := megatoword(rbuffer[tpos+5]+rbuffer[tpos+6]);
  973.                 w3 := megatoword(rbuffer[tpos+7]+rbuffer[tpos+8]);
  974.                 w4 := megatoword(rbuffer[tpos+9]+rbuffer[tpos+10]);
  975.                 o1 := megab(rbuffer[tpos+11]);
  976.                 o2 := megab(rbuffer[tpos+12]);
  977.                 writepas('Mouse('+i2s(w1)+','+i2s(w2)+','+i2s(w3)+','+i2s(w4)+','+torf(o1)+','+torf(o2)+','''+s1+''');');
  978.                 exit;
  979.               end;
  980.             end;
  981.             'K' : begin {kill mouse fields}
  982.               writepas('KillMouseFields;');
  983.               exit;
  984.             end;
  985.             'T' : begin {begin text}
  986.               if bufcount = (pos('T',st5)+ 10) then
  987.               begin
  988.                 exit;
  989.               end;
  990.             end;
  991.             't' : begin {region text}
  992.               if doexit or nextcommand then
  993.               begin
  994.                 exit;
  995.               end;
  996.             end;
  997.             'E' : begin {end text}
  998.               exit;
  999.             end;
  1000.             'C' : begin {get image}
  1001.               if bufcount = (pos('C',st5)+ 9) then
  1002.               begin
  1003.                 w1 := megatoword(rbuffer[tpos+1]+rbuffer[tpos+2]);
  1004.                 w2 := megatoword(rbuffer[tpos+3]+rbuffer[tpos+4]);
  1005.                 w3 := megatoword(rbuffer[tpos+5]+rbuffer[tpos+6]);
  1006.                 w4 := megatoword(rbuffer[tpos+7]+rbuffer[tpos+8]);
  1007.                 writepas('GetImage('+i2s(w1)+','+i2s(w2)+','+i2s(w3)+','+i2s(w4)+');');
  1008.                 exit;
  1009.               end;
  1010.             end;
  1011.             'P' : begin {put image}
  1012.               if bufcount = (pos('P',st5)+ 7) then
  1013.               begin
  1014.                 w1 := megatoword(rbuffer[tpos+1]+rbuffer[tpos+2]);
  1015.                 w2 := megatoword(rbuffer[tpos+3]+rbuffer[tpos+4]);
  1016.                 w3 := megatoword(rbuffer[tpos+5]+rbuffer[tpos+6]);
  1017.                 writepas('PutImage('+i2s(w1)+','+i2s(w2)+','+i2s(w3)+');');
  1018.                 exit;
  1019.               end;
  1020.             end;
  1021.             'W' : begin {write icon}
  1022.               if doexit or nextcommand then
  1023.               begin
  1024.                 s1 := '';
  1025.                 for sctr := tpos+2 to bufcount do
  1026.                   s1 := s1 + rbuffer[sctr];
  1027.                 writepas('WriteIcon('''+s1+''');');
  1028.                 exit;
  1029.               end;
  1030.             end;
  1031.             'I' : begin {load icon}
  1032.               if doexit or nextcommand then
  1033.               begin
  1034.                 s1 := '';
  1035.                 for sctr := tpos+10 to bufcount do
  1036.                   s1 := s1 + rbuffer[sctr];
  1037.                 w1 := megatoword(rbuffer[tpos+1]+rbuffer[tpos+2]);
  1038.                 w2 := megatoword(rbuffer[tpos+3]+rbuffer[tpos+4]);
  1039.                 w3 := megatoword(rbuffer[tpos+5]+rbuffer[tpos+6]);
  1040.                 o1 := megab(rbuffer[tpos+7]);
  1041.                 writepas('LoadIcon('+i2s(w1)+','+i2s(w2)+','+i2s(w3)+','+torf(o1)+','''+s1+''');');
  1042.                 exit;
  1043.               end;
  1044.             end;
  1045.             'B' : begin {button style}
  1046.               if bufcount = (pos('B',st5)+ 36) then
  1047.               begin
  1048.                 DoTheButtonStyle;
  1049.                 exit;
  1050.               end;
  1051.             end;
  1052.             'U' : begin {button}
  1053.               if doexit or nextcommand then
  1054.               begin
  1055.                 DoTheButton;
  1056.                 exit;
  1057.               end;
  1058.             end;
  1059.             'D' : begin {define}
  1060.               if doexit or nextcommand then
  1061.               begin
  1062.                 exit;
  1063.               end;
  1064.             end;
  1065.             #27 : begin {query}
  1066.               if doexit or nextcommand then
  1067.               begin
  1068.                 exit;
  1069.               end;
  1070.             end;
  1071.             'G' : begin {copy region}
  1072.               if bufcount = (pos('G',st5)+ 12) then
  1073.               begin
  1074.                 exit;
  1075.               end;
  1076.             end;
  1077.             'R' : begin {read scene}
  1078.               if doexit or nextcommand then
  1079.               begin
  1080.                 exit;
  1081.               end;
  1082.             end;
  1083.             'F' : begin {file query}
  1084.               if doexit or nextcommand then
  1085.               begin
  1086.                 exit;
  1087.               end;
  1088.             end;
  1089.             else {case command of}
  1090.               exit;
  1091.           end; {case}
  1092.         end;
  1093.         9 : begin
  1094.           case command of
  1095.             #27 : begin {enter block mode}
  1096.               if doexit or nextcommand then
  1097.               begin
  1098.                 exit;
  1099.               end;
  1100.             end;
  1101.             else {case}
  1102.               exit;
  1103.           end; {case command of}
  1104.         end;
  1105.         else {case level of}
  1106.           exit;
  1107.       end; {case level of}
  1108.       if doexit then
  1109.         exit;
  1110.     end; {got_command}
  1111.   end; {case}
  1112.   doripchar := true;
  1113. end;
  1114.  
  1115. Function Exists(FN : string) : boolean;
  1116. var
  1117.   F     : searchrec;
  1118. begin
  1119.   findfirst (FN,AnyFile,F);
  1120.   Exists := DosError = 0;
  1121. end;
  1122.  
  1123. Procedure InitOutFile;
  1124. begin
  1125.   if exists(paramstr(2)) then
  1126.   begin
  1127.     writeln(' ■ Error: ',paramstr(2),' already exists.');
  1128.     writeln(' ■ Exiting...');
  1129.     halt;
  1130.   end;
  1131.   assign(outfile,paramstr(2));
  1132.   {$I-}
  1133.   rewrite(outfile);
  1134.   {$I+}
  1135.   if ioresult <> 0 then
  1136.   begin
  1137.     writeln(' ■ Error: Creating ',paramstr(2));
  1138.     writeln(' ■ Exiting...');
  1139.     halt;
  1140.   end;
  1141.   writeln(outfile,'{This file created by RIP2PAS}');
  1142.   writeln(outfile,'{May require editing before use.}');
  1143.   writeln(outfile);
  1144.   writeln(outfile,'Procedure Display',paramstr(1),';');
  1145.   writeln(outfile,'Type');
  1146.   writeln(outfile,'  PointRec = record');
  1147.   writeln(outfile,'    X : word;');
  1148.   writeln(outfile,'    Y : word;');
  1149.   writeln(outfile,'  end;');
  1150.   writeln(outfile);
  1151.   writeln(outfile,'  TempType = Array[1..512] of PointRec;');
  1152.   writeln(outfile);
  1153.   writeln(outfile,'Var');
  1154.   writeln(outfile,'  PPoints : TempType;');
  1155.   writeln(outfile,'  tFPT    : Array[1..8] of Byte;');
  1156.   writeln(outfile);
  1157.   writeln(outfile,'Begin');
  1158. end;
  1159.  
  1160. Begin
  1161.   Writeln('RIP2PAS Converts .RIP files to RIPlink Pascal source.');
  1162.   if paramcount < 2 then
  1163.   begin
  1164.     writeln('');
  1165.     writeln('Usage: RIP2PAS <input file (*.RIP)> <output file>');
  1166.     writeln('No wildcards allowed.');
  1167.     writeln;
  1168.     halt;
  1169.   end;
  1170.   InitOutFile;
  1171.   if not DisplayRipFile(paramstr(1)) then
  1172.   begin
  1173.     writeln(' ■ Error: Opening ',paramstr(1));
  1174.     writeln(' ■ Exiting...');
  1175.     writeln(outfile,'{Abnormal termination}');
  1176.     close(outfile);
  1177.     halt;
  1178.   end;
  1179.   writeln(outfile,'end;');
  1180.   close(outfile);
  1181.   writeln(' ■ ',paramstr(2),' successfully written.');
  1182. End.
  1183.